home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_Tix.idb / usr / freeware / lib / tix4.1 / DragDrop.tcl.z / DragDrop.tcl
Encoding:
Text File  |  1999-01-26  |  3.7 KB  |  162 lines
  1. # DragDrop.tcl ---
  2. #
  3. #    Implements drag+drop for Tix widgets.
  4. #
  5. # Copyright (c) 1996, Expert Interface Technologies
  6. #
  7. # See the file "license.terms" for information on usage and redistribution
  8. # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  9. #
  10.  
  11. tixClass tixDragDropContext {
  12.     -superclass {}
  13.     -classname  TixDragDropContext
  14.     -method {
  15.     cget configure drag drop set startdrag
  16.     }
  17.     -flag {
  18.     -command -source
  19.     }
  20.     -configspec {
  21.     {-command ""}
  22.     {-source ""}
  23.     }
  24. }
  25.  
  26. proc tixDragDropContext:Constructor {w} {
  27.     upvar #0 $w data
  28. }
  29.  
  30. #----------------------------------------------------------------------
  31. # Private methods
  32. #
  33. #----------------------------------------------------------------------
  34. proc tixDragDropContext:CallCommand {w target command X Y} {
  35.     upvar #0 $w data
  36.      
  37.     set x [expr $X-[winfo rootx $target]]
  38.     set y [expr $Y-[winfo rooty $target]]
  39.     
  40.     regsub %x $command $x command
  41.     regsub %y $command $y command
  42.     regsub %X $command $X command
  43.     regsub %Y $command $Y command
  44.     regsub %W $command $target command
  45.     regsub %S $command [list $data(-command)] command
  46.  
  47.     eval $command
  48. }
  49.  
  50. proc tixDragDropContext:Send {w target event X Y} {
  51.     upvar #0 $w data
  52.     global tixDrop
  53.  
  54.     foreach tag [tixDropBindTags $target] {
  55.     if [info exists tixDrop($tag,$event)] {
  56.         tixDragDropContext:CallCommand $w $target \
  57.         $tixDrop($tag,$event) $X $Y
  58.     }
  59.     }
  60. }
  61.  
  62. #----------------------------------------------------------------------
  63. # set --
  64. #
  65. #    Set the "small data" of the type supported by the source widget
  66. #----------------------------------------------------------------------
  67.  
  68. proc tixDragDropContext:set {w type data} {
  69.  
  70. }
  71.  
  72. #----------------------------------------------------------------------
  73. # startdrag --
  74. #
  75. #    Start the dragging action
  76. #----------------------------------------------------------------------
  77. proc tixDragDropContext:startdrag {w x y} {
  78.     upvar #0 $w data
  79.  
  80.     set data(oldTarget) ""
  81.  
  82.     $data(-source) config -cursor "[tix getbitmap drop] black"
  83.     tixDragDropContext:drag $w $x $y
  84. }
  85.  
  86. #----------------------------------------------------------------------
  87. # drag --
  88. #
  89. #    Continue the dragging action
  90. #----------------------------------------------------------------------
  91. proc tixDragDropContext:drag {w X Y} {
  92.     upvar #0 $w data
  93.     global tixDrop
  94.  
  95.     set target [winfo containing $X $Y]
  96.  
  97.     if {$target != $data(oldTarget)} {
  98.     if {$data(oldTarget) != ""} {
  99.         tixDragDropContext:Send $w $data(oldTarget) <Out> $X $Y 
  100.     }
  101.     if {$target != ""} {
  102.         tixDragDropContext:Send $w $target <In> $X $Y
  103.     }
  104.     set data(oldTarget) $target
  105.     }
  106.     if {$target != ""} {
  107.     tixDragDropContext:Send $w $target <Over> $X $Y
  108.     }
  109. }
  110.  
  111. proc tixDragDropContext:drop {w X Y} {
  112.     upvar #0 $w data
  113.     global tixDrop
  114.  
  115.     set target [winfo containing $X $Y]
  116.     if {$target != ""} {
  117.     tixDragDropContext:Send $w $target <Drop> $X $Y
  118.     }
  119.  
  120.     if {$data(-source) != ""} {
  121.     $data(-source) config -cursor ""
  122.     }
  123.     set data(-source) ""
  124. }
  125.  
  126. #----------------------------------------------------------------------
  127. # Public Procedures -- This is NOT a member of the tixDragDropContext
  128. #               class!
  129. #
  130. # parameters :
  131. #    $w:    who wants to start dragging? (currently ignored)
  132. #----------------------------------------------------------------------
  133. proc tixGetDragDropContext {w} {
  134.     global tixDD
  135.     if {[info exists tixDD]} {
  136.     return tixDD
  137.     }
  138.  
  139.     return [tixDragDropContext tixDD]
  140. }
  141.  
  142. proc tixDropBind {w event command} {
  143.     global tixDrop
  144.  
  145.     set tixDrop($w) 1
  146.     set tixDrop($w,$event) $command
  147. }
  148.  
  149. proc tixDropBindTags {w args} {
  150.     global tixDropTags
  151.  
  152.     if {$args == ""} {
  153.     if [info exists tixDropTags($w)] {
  154.         return $tixDropTags($w)
  155.     } else {
  156.         return [list [winfo class $w] $w]
  157.     }
  158.     } else {
  159.     set tixDropTags($w) $args
  160.     }
  161. }
  162.